home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-11-08 | 13.0 KB | 531 lines | [TEXT/MPS ] |
- PROGRAM Test;
-
- USES
- UMacApp,
-
- { Building Blocks }
- UPrinting, UGridView, UTEView, UDialog,
- UArray, USizerView,
-
- { ToolBox }
- Types, QuickDraw, Packages,
- Fonts, Resources, Strings, ToolUtils, { ToolIntf }
- OSUtils, Files, Errors, Memory; { OSIntf }
-
- CONST
- kSignature = 'Test'; { Application signature}
- kFileType = 'test'; { file type of parsed data file. }
-
- { Resource ids }
- kTestWindowID = 1001; { main window }
- kStringList1 = 2000; { STR# resource for left pane }
- kStringList2 = 2001; { STR# resource for second pane }
- kStringList3 = 2002; { STR# resource for third pane }
- kStringList4 = 2003; { STR# resource for right pane }
-
- { Commands }
- cNewSplitHWindow = 1205; { Open a new window with horizontal sizer & splitter }
- cNewSplitVWindow = 1206; { Open a new window with vertical sizer & splitter }
-
- kMinH = 4*kMinSizerPane + 3*kSizerThickness; { 4 panes across }
- kMinV = 2*kMinSizerPane + kSizerThickness; { 2 stacked panes }
-
- TYPE
-
- TTestApplication = OBJECT (TApplication)
-
- PROCEDURE TTestApplication.ITestApplication;
- { Initializes the application and globals. }
-
- FUNCTION TTestApplication.DoMakeDocument(itsCmdNumber: CmdNumber): TDocument; OVERRIDE;
- { Create a document object that will create the window. }
-
- FUNCTION TTestApplication.DoMenuCommand(aCmdNumber: CmdNumber): TCommand; OVERRIDE;
- PROCEDURE TTestApplication.DoSetupMenus; OVERRIDE;
-
- END;
-
- TTestDocument = OBJECT(TDocument)
-
- fListViews: TList; { of TTestListViews }
- fTextView: TTestView; { shows current list selections }
-
- PROCEDURE TTestDocument.ITestDocument(itsCmdNumber: CmdNumber);
- { Initialize the test document. }
-
- PROCEDURE TTestDocument.Free; OVERRIDE;
- { Free the list we created }
-
- PROCEDURE TTestDocument.ChangeData;
- { Change fTextView's data to reflect current selection }
-
- PROCEDURE TTestDocument.DoChoice(origView: TView; itsChoice: INTEGER); OVERRIDE;
- { Handle communication from subviews }
-
- PROCEDURE TTestDocument.DoMakeViews(forPrinting: BOOLEAN); OVERRIDE;
- { Create the window and views to display the data. }
-
- END;
-
- TTestListView = OBJECT (TTextListView)
- { This list view gets its items from a STR# resource }
-
- fStringListId: INTEGER; { Id of STR# resource }
-
- PROCEDURE TTestListView.ITestListView(itsStringList: INTEGER);
- { Tell the view which STR# resource to get its items from. Set the number
- of items to be the same as the number of strings in the resource. }
-
- PROCEDURE TTestListView.GetItemText(anItem: INTEGER; VAR aString: Str255); OVERRIDE;
-
- PROCEDURE TTestListView.SelectItem(anItem: INTEGER; extendSelection, highlight,
- select: BOOLEAN); OVERRIDE;
-
- END;
-
- TTestView = OBJECT (TView)
-
- fDataHandle: Handle; { text for display }
- fTextStyle: TextStyle; { style for displaying text }
-
- PROCEDURE TTestView.IRes(itsDocument: TDocument; itsSuperView: TView;
- VAR itsParams: Ptr); OVERRIDE;
-
- PROCEDURE TTestView.Draw(area: Rect); OVERRIDE;
- { Draw the current selections of the TTextListViews }
-
- PROCEDURE TTestView.Free; OVERRIDE;
- { Free any leftover data }
-
- PROCEDURE TTestView.SetData(newData: Handle);
- { Set the data handle to the given handle. Dispose the old one }
-
- END;
-
- TStupidView = OBJECT (TView)
- { A stupid view that does nothing but draw something }
-
- fNumber: INTEGER;
-
- PROCEDURE TStupidView.IStupidView(itsNumber: INTEGER);
-
- FUNCTION TStupidView.Clone: TObject; OVERRIDE;
-
- PROCEDURE TStupidView.Draw(area: Rect); OVERRIDE;
-
- FUNCTION TStupidView.GetNumber: INTEGER;
-
- END;
-
-
- VAR
- gTestApplication: TTestApplication;
-
-
- {------------------------ TTestApplication ------------------------------------------}
-
- {$S AInit}
-
- PROCEDURE TTestApplication.ITestApplication;
-
- BEGIN
- InitUSizerView; { Init the gnarly split pane meister. }
-
- IApplication(kFileType);
-
- { Suppress dead-stripping of classes created from view templates }
- IF gDeadStripSuppression THEN BEGIN
- IF Member(TObject(NIL), TTestView) THEN;
- IF Member(TObject(NIL), TTestListView) THEN;
- IF Member(TObject(NIL), TStupidView) THEN;
- END;
- END;
-
- FUNCTION TTestApplication.DoMakeDocument(itsCmdNumber: CmdNumber): TDocument; OVERRIDE;
- { Called by OpenNew and OpenOld: cNew and cOpen }
-
- VAR
- aTestDocument: TTestDocument;
- fi: FailInfo;
-
- PROCEDURE InitFailed(error: OSErr; message: LONGINT);
- BEGIN
- FreeIfObject(aTestDocument);
- END;
-
- BEGIN
- { Allocate and initialize a test document. }
- NEW(aTestDocument);
- FailNIL(aTestDocument);
-
- CatchFailures(fi, InitFailed);
- aTestDocument.ITestDocument(itsCmdNumber);
- Success(fi);
-
- DoMakeDocument := aTestDocument;
- END;
-
- {$S ASelCommand}
-
- FUNCTION TTestApplication.DoMenuCommand(aCmdNumber: CmdNumber): TCommand; OVERRIDE;
-
- PROCEDURE MakeSplitterWindow(windId: INTEGER; sizerId: IDType);
-
- VAR
- aWindow: TWindow;
- aSizerView: TSizerView;
- aStupidView: TStupidView;
-
- BEGIN
- aWindow := NewTemplateWindow(windId, NIL);
- FailNIL(aWindow);
-
- aSizerView := TSizerView(aWindow.FindSubview(sizerId));
- IF qDebug THEN FailNIL(aSizerView);
- aSizerView.FixupPanes(FALSE);
-
- aStupidView := TStupidView(aWindow.FindSubview('stpd'));
- IF qDebug THEN FailNIL(aStupidView);
- aStupidView.IStupidView(aCmdNumber);
-
- aWindow.Open;
- END;
-
- BEGIN
- CASE aCmdNumber OF
- cNewSplitHWindow: MakeSplitterWindow(aCmdNumber, 'hsiz');
- cNewSplitVWindow: MakeSplitterWindow(aCmdNumber, 'vsiz');
-
- OTHERWISE
- DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber);
- END;
- END;
-
- {$S ARes}
-
- PROCEDURE TTestApplication.DoSetupMenus; OVERRIDE;
-
- BEGIN
- INHERITED DoSetupMenus;
-
- Enable(cNewSplitHWindow, TRUE);
- Enable(cNewSplitVWindow, TRUE);
- END;
-
- {-------------------------- TTestDocument -------------------------------------------}
-
- {$S AOpen}
-
- PROCEDURE TTestDocument.ITestDocument(itsCmdNumber: CmdNumber);
-
- BEGIN
- fTextView := NIL;
- fListViews := NIL;
-
- IDocument(kFileType, kSignature, NOT kUsesDataFork, NOT kUsesRsrcFork,
- NOT kDataOpen, NOT kRsrcOpen);
-
- fListViews := NewList;
- fListViews.SetEltType('TTestListView');
- END;
-
- {$S AClose}
-
- PROCEDURE TTestDocument.Free; OVERRIDE;
-
- BEGIN
- fListViews.DeleteAll;
- fListViews.Free;
- INHERITED Free;
- END;
-
- {$S ADoCommand}
-
- PROCEDURE TTestDocument.ChangeData;
-
- VAR
- newData: Handle;
- s: INTEGER;
- offset: LONGINT;
- newSize: LONGINT;
- aListView: TTestListView;
- aString: Str255;
-
- BEGIN
- newData := NewHandle(0);
- FailNIL(newData);
-
- FOR s := 1 TO fListViews.GetSize DO BEGIN
- aListView := TTestListView(fListViews.At(s));
- WITH aListView DO { get the view's current selection }
- GetItemText(FirstSelectedItem, aString);
- { Append aString’s text part to handle data }
- offset := GetHandleSize(newData);
- newSize := offset + LENGTH(aString) + 1; { allow for separator char }
- SetHandleSize(newData, newSize); { make room for new stuff }
- newSize := LENGTH(aString) + 1; { number of chars to copy }
- aString[0] := CHR($0D); { separate with CR }
- BlockMove(@aString, Ptr(StripLong(newData^)+offset), newSize);
- END;
-
- fTextView.SetData(newData);
- END;
-
- {$S ADoCommand}
-
- PROCEDURE TTestDocument.DoChoice(origView: TView; itsChoice: INTEGER); OVERRIDE;
-
- VAR
- id: IDType;
-
- BEGIN
- IF itsChoice = mListItemHit THEN { user selected a list item }
- ChangeData; { change data to reflect new selection }
- END;
-
- {$S AOpen}
-
- PROCEDURE TTestDocument.DoMakeViews(forPrinting: BOOLEAN); OVERRIDE;
- { Create the views for this hog. All of them. In the city and in the streets. }
-
- VAR
- aWindow: TWindow;
- minSize: Point;
- aSizerView: TSizerView;
-
- PROCEDURE DoPostRes(viewId: IDType);
-
- VAR
- aSizerView: TSizerView;
-
- BEGIN
- aSizerView := TSizerView(aWindow.FindSubview(viewId));
- IF qDebug THEN FailNIL(aSizerView);
- aSizerView.FixupPanes(TRUE); { equally spaced panes }
- END;
-
- PROCEDURE InitListView(viewId: IDType; itsStringList: INTEGER);
-
- VAR
- aListView: TTestListView;
-
- BEGIN
- aListView := TTestListView(aWindow.FindSubview(viewId));
- IF qDebug THEN FailNIL(aListView);
- aListView.ITestListView(itsStringList);
- fListViews.InsertLast(aListView);
- END;
-
- BEGIN
- aWindow := NewTemplateWindow(kTestWindowID, SELF);
- FailNIL(aWindow);
-
- { Make sure that the minimum size for the window is reasonable for the
- TSizerViews we are using. }
- SetPt(minSize, kMinH, kMinV);
- aWindow.SetResizeLimits(minSize, gStdWSizeRect.botRight);
-
- { Set the thickness of the splitter bars (do this before FixupPanes) }
- aSizerView := TSizerView(aWindow.FindSubview('main'));
- aSizerView.SetSizerThickness(10);
-
- { Finish installing the subviews in the TSizerViews }
- DoPostRes('main');
- DoPostRes('uppr');
- fTextView := TTestView(aWindow.FindSubview('lowr'));
-
- { Finish initializing the list views }
- InitListView('aaaa', kStringList1);
- InitListView('bbbb', kStringList2);
- InitListView('cccc', kStringList3);
- InitListView('dddd', kStringList4);
-
- { Set the minimum width for the list panes }
- aSizerView := TSizerView(aWindow.FindSubview('uppr'));
- aSizerView.SetMinPaneLength(30);
- END;
-
- {-------------------------- TTestListView -------------------------------------------}
-
- {$S AOpen}
-
- PROCEDURE TTestListView.ITestListView(itsStringList: INTEGER);
-
- VAR
- items: INTEGER;
-
- FUNCTION CountStrings(strID: INTEGER): INTEGER;
- { Return the number of strings contained in the specified STR# resource }
-
- TYPE
- strResource = RECORD
- count: INTEGER;
- firstStr: Str255; { actually, an array of variable-length strings }
- END;
- strPointer = ^strResource;
- strHandle = ^strPointer;
-
- VAR
- strRes: strHandle;
-
- BEGIN
- strRes := strHandle(GetResource('STR#', strID));
- IF strRes = NIL
- THEN CountStrings := 0
- ELSE CountStrings := strRes^^.count;
- END;
-
- BEGIN
- fStringListId := itsStringList;
- items := CountStrings(itsStringList);
- InsItemLast(items);
- END;
-
- {$S ARes}
-
- PROCEDURE TTestListView.GetItemText(anItem: INTEGER; VAR aString: Str255); OVERRIDE;
-
- BEGIN
- IF anItem = 0
- THEN aString := ''
- ELSE GetIndString(aString, fStringListId, anItem);
- END;
-
- {$S ASelCommand}
-
- PROCEDURE TTestListView.SelectItem(anItem: INTEGER; extendSelection, highlight, select: BOOLEAN); OVERRIDE;
-
- BEGIN
- INHERITED SelectItem(anItem, extendSelection, highlight, select);
-
- fDocument.DoChoice(SELF, mListItemHit); { inform the document }
- END;
-
- {---------------------------- TTestView ---------------------------------------------}
-
- {$S AOpen}
-
- PROCEDURE TTestView.IRes(itsDocument: TDocument; itsSuperView: TView;
- VAR itsParams: Ptr); OVERRIDE;
-
- VAR
- aTextStyle: TextStyle;
-
- BEGIN
- fDataHandle := NIL;
- INHERITED IRes(itsDocument, itsSuperView, itsParams);
-
- SetTextStyle(aTextStyle, 0, [], 12, gRGBBlack); { System font, plain, 12 point }
- fTextStyle := aTextStyle;
- END;
-
- {$S AClose}
-
- PROCEDURE TTestView.Free; OVERRIDE;
-
- BEGIN
- fDataHandle := DisposeIfHandle(fDataHandle);
- INHERITED Free;
- END;
-
- {$S ARes}
-
- PROCEDURE TTestView.Draw(area: Rect); OVERRIDE;
-
- VAR
- box: Rect;
- itsLength: LONGINT;
- aTextStyle: TextStyle;
-
- BEGIN
- IF fDataHandle <> NIL THEN BEGIN { there’s something to draw }
- aTextStyle := fTextStyle;
- SetPortTextStyle(aTextStyle);
- GetQDExtent(box);
- InsetRect(box, 5, 0); { leave some margin on the sides }
- itsLength := GetHandleSize(fDataHandle);
- LockHandleHigh(fDataHandle); { because MATextBox may move memory }
- MATextBox(fDataHandle^, itsLength, box, teJustSystem, kAutoWrap, NIL, kNoEraseFirst, kNoSpaceForCaret);
- HUnlock(fDataHandle);
- END;
- INHERITED Draw(area);
- END;
-
- {$S ADoCommand}
-
- PROCEDURE TTestView.SetData(newData: Handle);
-
- BEGIN
- fDataHandle := DisposeIfHandle(fDataHandle);
- fDataHandle := newData;
- ForceRedraw;
- END;
-
- {---------------------------- TStupidView ---------------------------------------------}
-
- {$S AOpen}
-
- PROCEDURE TStupidView.IStupidView(itsNumber: INTEGER);
-
- BEGIN
- fNumber := itsNumber;
- END;
-
- {$S ARes}
-
- PROCEDURE TStupidView.Draw(area: Rect); OVERRIDE;
-
- VAR
- aString: Str255;
-
- BEGIN
- TextFont(0);
- TextSize(12);
- MoveTo(10, 20); (* h, v *)
- NumToString(fNumber, aString);
- aString := concat('duh…', aString);
- DrawString(aString);
-
- INHERITED Draw(area);
- END;
-
- FUNCTION TStupidView.GetNumber: INTEGER;
-
- BEGIN
- GetNumber := fNumber;
- END;
-
- FUNCTION TStupidView.Clone: TObject; OVERRIDE;
-
- VAR
- theClone: TStupidView;
-
- BEGIN
- theClone := TStupidView(INHERITED Clone);
- theClone.IStupidView(fNumber + 1); { so we can tell them apart! }
- Clone := theClone;
- END;
-
- {------------------------------------------------------------------------------------}
- { T H E M A I N P R O G R A M }
- {$S Main}
-
- BEGIN
- InitToolBox; { Essential toolbox and utilities
- initialization }
- IF ValidateConfiguration(gConfiguration) THEN { Make sure we can run }
- BEGIN
- InitUMacApp(20); { Initialize the Toolbox, making lots of calls to MoreMasters }
- InitUTEView; { Initialize TEView unit }
- InitUDialog; { Initialize other units }
- InitUGridView;
-
- NEW(gTestApplication); { Allocate a new TTestApplication object }
- FailNIL(gTestApplication);
- gTestApplication.ITestApplication; { Initialize that new object }
-
- gTestApplication.Run; { Run the application. When it's done, exit. }
- END
- ELSE
- StdAlert(phUnsupportedConfiguration);
- END.